home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Taifun / Taifun 099 (1989-05-15)(Ossowski, Stefan)(DE)(PD).zip / Taifun 099 (1989-05-15)(Ossowski, Stefan)(DE)(PD).adf / PCQ / Examples / RealIO.p < prev    next >
Text File  |  1989-03-31  |  4KB  |  165 lines
  1. program realnums;
  2.  
  3. {$I "Include/Math.i"}
  4. {$I "Include/MathTrans.i"}
  5.  
  6. var
  7.    s : real;
  8.  
  9. {
  10.     Eventually real numbers will be fully supported by PCQ, and
  11. I'll need to write input/output routines for them.  These are an
  12. interim solution.  The example just writes to stdout.  There are also
  13. routines present that read from stdin and read and write from files.
  14. Note that the read from stdin routine actually eats one character
  15. that it shouldn't.  The read-from-file routine doesn't, since it can
  16. access the buffered char.  Once I get these routines into the
  17. lanugage there won't be this problem, of course.
  18.     Be sure to read MathTrans.i before you use it.
  19. }
  20.  
  21. procedure writereal(r : real; i, f : short);
  22.  
  23.     { sorry about the cryptic variable names.  'r' is the number
  24.       to write, 'i' is the field width to the left of the decimal
  25.       point (the integer part), and 'f' is the field width to the
  26.       right of the decimal point (fractional part).  Note that 'i'
  27.       is rudely ignored in this version, since field widths must
  28.       be constant expressions. }
  29.  
  30. var
  31.     t : integer;
  32.     exponent : integer;
  33.     index : integer;
  34. begin
  35.     exponent := 0;
  36.     if spcmp(r, spfloat(100000)) < 0 then begin
  37.     while spcmp(r, spfloat(10)) < 0 do begin
  38.         exponent := exponent + 1;
  39.         r := spdiv(r, spfloat(10));
  40.     end;
  41.     end;
  42.     if sptst(r) < 0 then begin
  43.     r := spabs(r);
  44.     write('-');
  45.     if i > 1 then
  46.         i := i - 1;
  47.     end;
  48.     t := spfix(r);
  49.     r := spsub(r, spfloat(t));
  50.     write(t);
  51.     if f > 0 then begin
  52.     write('.');
  53.     for index := 1 to f do begin
  54.         r := spmul(r, spfloat(10));
  55.         t := spfix(r);
  56.         r := spsub(r, spfloat(t));
  57.         write(chr(t + ord('0')));
  58.     end;
  59.     end;
  60.     if exponent > 0 then
  61.     write('+E', exponent);
  62. end;
  63.  
  64. procedure writerealfile(var filevar : text; r : real; i, f : short);
  65.  
  66.    { read writefile() for an explanation of the variable names.  'i'
  67.      is still ignored. }
  68.  
  69. var
  70.     t : integer;
  71.     exponent : integer;
  72.     index : integer;
  73. begin
  74.     exponent := 0;
  75.     if spcmp(r, spfloat(100000)) < 0 then begin
  76.     while spcmp(r, spfloat(10)) < 0 do begin
  77.         exponent := exponent + 1;
  78.         r := spdiv(r, spfloat(10));
  79.     end;
  80.     end;
  81.     if sptst(r) < 0 then begin
  82.     r := spabs(r);
  83.     write(filevar, '-');
  84.     if i > 1 then
  85.         i := i - 1;
  86.     end;
  87.     t := spfix(r);
  88.     r := spsub(r, spfloat(t));
  89.     write(filevar, t);
  90.     if f > 0 then begin
  91.     write(filevar, '.');
  92.     for index := 1 to f do begin
  93.         r := spmul(r, spfloat(10));
  94.         t := spfix(r);
  95.         r := spsub(r, spfloat(t));
  96.         write(filevar, chr(t + ord('0')));
  97.     end;
  98.     end;
  99.     if exponent > 0 then
  100.     write(filevar, '+E', exponent);
  101. end;
  102.  
  103. procedure readreal(var r : real);
  104. var
  105.     t : integer;
  106.     c : char;
  107.     pow : real;
  108. begin
  109.     read(t);
  110.     r := spfloat(t);
  111.     read(c);
  112.     if c = '.' then begin
  113.     read(c);
  114.     pow := spfloat(10);
  115.     while (c >= '0') and (c <= '9') do begin
  116.         r := spadd(spdiv(spfloat(ord(c) - ord('0')), pow), r);
  117.         pow := spmul(pow, spfloat(10));
  118.         read(c);
  119.     end;
  120.     end;
  121. end;
  122.  
  123. procedure readrealfile(var f : text; var r : real);
  124. var
  125.     t : integer;
  126.     pow : real;
  127. begin
  128.     read(f, t);
  129.     r := spfloat(t);
  130.     if f^ = '.' then begin
  131.     get(f);
  132.     pow := spfloat(10);
  133.     while (f^ >= '0') and (f^ <= '9') do begin
  134.         r := spadd(spdiv(spfloat(ord(f^) - ord('0')), pow), r);
  135.         pow := spmul(pow, spfloat(10));
  136.         get(f);
  137.     end;
  138.     end;
  139. end;
  140.  
  141. begin
  142.     if not OpenMathTrans() then begin
  143.     writeln('Could not open disk-based MathTrans.library');
  144.     exit(20);
  145.     end;
  146.     s := spfloat(0);
  147.     writeln("radians\tsine\tcosine\tlog");
  148.     while spcmp(s, spfloat(7)) > 0 do begin
  149.     writereal(s, 1, 2);
  150.     write(chr(9));
  151.     writereal(spsin(s), 1, 4);
  152.     write(chr(9));
  153.     writereal(spcos(s), 1, 4);
  154.     write(chr(9));
  155.     if spcmp(s, spfloat(0)) = 0 then
  156.         write('Undefined')
  157.     else
  158.         writereal(splog(s), 1, 4);
  159.     writeln;
  160.     s := spadd(s, spdiv(spfloat(1), spfloat(10)));
  161.     end;
  162.     FlushMathTrans;
  163. end.
  164.  
  165.